CD ROM Paradise Collection 4/CD ROM Paradise Collection 4 1995 Nov.iso/program/tjgold.zip/INSTALL.001/GOLDGRID.PAS

Pascal/Delphi Source File | 1995-07-12 | 42KB | 1,403 lines

{--------------------------------------------------------------------------}
{                Product: TechnoJock's Turbo Toolkit                       }
{                Version: GOLD                                             }
{                Build:   1.01                                             }
{                                                                          }
{                Copyright 1986-1995  TechnoJock Software, Inc.            }
{                           All Rights Reserved                            }
{                          Restricted by License                           }
{--------------------------------------------------------------------------}

                    {**********************************}
                    {**       Unit:   GOLDGRID       **}
                    {**********************************}

{++++++++++++++++++++++++++++++} unit GOLDGRID; {++++++++++++++++++++++++++++}

{$I GOLDFLAG.INC}
{$IFNDEF GOLDGRID}
   {$DEFINE GOLDGRID}
{$ENDIF}

{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}

uses DOS, CRT, GoldHard, GoldMisc, GoldKey, GoldFast, GoldWin, GoldLink,
     GoldList, GoldIO, GoldStr, GoldTint;

type
   GridSet = record
      LastECode: integer;
      GridCorner: char;
      EMsgFunc: ErrMsgFunc;
   end;

{Grid Lists}
function  LastGridError: integer;
procedure GridSetError(ECode:integer);
procedure GridSetLocks(var ListDetails: ListCfg;LCol,LRow:byte);
procedure GridAssignTabs(var ListDetails: ListCfg; TA:pGridTabArray; Dim:integer);
procedure GridProcessKey(var ListDetails: ListCfg;var K:word;X,Y:byte;MakeLocal:boolean);
procedure GridRefresh(var ListDetails: ListCfg; Status:gStatus);
procedure RunGrid(var ListDetails: ListCfg;Tit:StrScreen);
function  LaunchGrid(var ListDetails: ListCfg;Tit:StrScreen; CloseProc:ListCloseProc): byte;

var
   GridVars: GridSet;

{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}

                 {**************************************}
                 {**       G R I D    L I S T S       **}
                 {**************************************}

{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}

function GridEMsg(ECode:integer): string;
{}
begin
   case Ecode of
      0: GridEMsg := 'OK';
      else
         GridEMsg := 'Internal Grid error';
   end; {case}
end; { GridEMsg }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

procedure GridSetError(ECode:integer);
{}
{$IFOPT D+}
var Msg: string;
{$ENDIF}
begin
   GridVars.LastEcode := ECode;
{$IFOPT D+}  {if debug active display an error message and terminate}
   if Ecode <> 0 then
   begin
      str(Ecode,Msg);
      Msg := Msg+': '+GridVars.EMsgFunc(Ecode);
      SetWinIgnore(true);
      if PromptCustom(' GoldGrid Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
         Halt;
   end;
{$ENDIF}
end; {GridSetError}

function LastGridError: integer;
{}
begin
   LastGridError := GridVars.LastECode;
end; { LastGridError }

procedure GridAssignTabs(var ListDetails: ListCfg; TA:pGridTabArray; Dim:integer);
{}
begin
   with ListDetails do
   begin
      TabsArrayPtr := TA;
      TabsArrayDim := Dim;
   end;
end; { GridAssignTabs }

procedure GridSetLocks(var ListDetails: ListCfg;LCol,LRow:byte);
{}
begin
   with ListDetails do
   begin
      ColumnLock := LCol;
      RowLock := LRow;
   end;
end; { GridSetLocks }

procedure GridAssignHeadingHook(var ListDetails: ListCfg; Proc:ListHindHook);
{}
begin
   Listdetails.WriteHeadingsHook := Proc;
end; {GridAssignHeadingHook}

                          {********************}
                          {**  Grid Display  **}
                          {********************}

procedure GridWriteVScrollBar(var ListDetails: ListCfg; Status:gStatus);
{}
var A:byte;
begin
   with ListDetails do
   begin
      if TotalNodes > succ(Y2-Y1) then {need a scroll bar}
      begin
         if Status in [Activate,HiStatus] then
            A := Col[ListScrollbarHi]
         else
            A := Col[ListScrollbarNorm];
         WriteVScrollBar(X2,Y1,Y2- ord(LastCol > X2-X1),A,ActiveNode,TotalNodes);
      end
   end;
end; { GridWriteVScrollBar }

procedure GridWriteHScrollBar(var ListDetails: ListCfg; Status:gStatus);
{}
var A:byte;
begin
   with ListDetails do
   begin
      if LastCol > X2-X1 then {need a scroll bar}
      begin
         if Status in [Activate,HiStatus] then
            A := Col[ListScrollbarHi]
         else
            A := Col[ListScrollbarNorm];
         WriteHScrollBar(X1,pred(X2),Y2,A,StartingCol,LastCol);
      end
   end;
end; {GridWriteHScrollBar}

procedure GridWriteItem(var ListDetails: ListCfg; ItemNum:longint; Status:gStatus);
{}
var
  Y,A:byte;
  Str:StrScreen;
  AvailWidth,
  TextWidth: shortint;
begin
   with ListDetails do
   begin
      if TotalNodes = 0 then
         exit;
      AvailWidth := X2 - pred(X1) - ord(TotalNodes > succ(Y2-Y1));
      if ItemNum <= TotalNodes then
      begin
         with ListVars do
            TextWidth := AvailWidth
                         - length(GridLeft)
                         - length(GridRight)
                         - ord(AllowTagging) * length(GridTag);
         if TextWidth > 0 then
         begin
            if (TabsArrayPtr = nil) then
            begin
               if (ColumnLock = 0) then
                  Str := GetStr(Listdetails.DataSource,ItemNum,StartingCol,pred(StartingCol)+TextWidth)
               else
               begin
                  Str := GetStr(Listdetails.DataSource,ItemNum,1,ColumnLock);
                  Str := Str + GetStr(Listdetails.DataSource,ItemNum,StartingCol,pred(StartingCol) + TextWidth - ColumnLock);
               end;
            end
            else
            begin
               if (ColumnLock <> 0) and (TabsArrayPtr^[ColumnLock] < TextWidth) then
               begin
                  Str := GetStr(Listdetails.DataSource,ItemNum,1,pred(TabsArrayPtr^[succ(ColumnLock)]));
                  Str := Str + GetStr(Listdetails.DataSource,ItemNum,StartingCol,
                                      pred(StartingCol)+TextWidth-pred(TabsArrayPtr^[succ(ColumnLock)]))
               end
               else
                  Str := GetStr(Listdetails.DataSource,ItemNum,StartingCol,pred(StartingCol) + TextWidth - ColumnLock);
            end;
         end
         else
            Str := '';
         if AllowTagging then  {add the tag character}
         begin
            if GetBit(DataSource,ItemNum,0) then
               Str := ListVars.GridTag + Str
            else
               Str := replicate(length(ListVars.GridTag),' ')+Str;
         end;
         if AllowTwoColors and GetBit(DataSource,ItemNum,1) then
            A := Col[ListNorm2]
         else
            A := Col[ListNorm1];
         if ItemNum = ActiveNode then
         begin
            Str := ListVars.GridLeft + Str + ListVars.GridRight;
            if (Status in [HiStatus,Activate]) then
            begin
               if AllowTwoColors and GetBit(DataSource,ItemNum,1) then
                  A := Col[ListHi2]
               else
                  A := Col[ListHi1];
            end;
         end
         else
            Str := replicate(length(ListVars.GridLeft),' ')+Str+replicate(length(ListVars.GridRight),' ');
      end
      else
      begin
         A := Col[ListNorm1];
         Str := replicate(AvailWidth,' ');
      end;
      {now we've created the item string we have to figure out where
       to write it}
      if RowLock = 0 then
         Y := Y1+ItemNum-TopNode
      else if ItemNum < RowLock then
         Y := pred(Y1) + ItemNum
      else
         Y := Y1 + pred(RowLock) + ItemNum - TopNode;
      Listdetails.ColorHook(ItemNum,ItemNum = ActiveNode,A);
      WriteAT(X1,Y,A,Str);
      if (Status in [HiStatus,Activate]) and (ItemNum = ActiveNode) then
      begin
         GridWriteVScrollBar(Listdetails,HiStatus);
         gotoxy(X1,Y);
      end;
   end;
end; { GridWriteItem }

procedure GridRefreshHeadFoot(var ListDetails: ListCfg);
{}
var
   Counter,
   I: integer;
   TempStr: string;
   W,X: byte;

   function GTabSubStr(var Source:string; TabPos:integer):string;
   {}
   begin
      with Listdetails do
         if TabPos <= TabsArrayDim then
            GTabSubStr := TabSubStr(Source,TabPos)
         else
            GTabSubStr := '';
   end; {GTabSubStr}

   procedure GetTitleStr(Str:string; Scroll:boolean);
   {}
   var
      Tabs,Counter,Wid: integer;
   begin
      with Listdetails do
      begin
         if not scroll or (TabsArrayDim = 0) then
         begin
             if not Scroll then
                TempStr := padleft(Str,W,' ')
             else
             begin
                if ColumnLock <> 0 then
                   TempStr := copy(Str,1,ColumnLock)
                else
                   TempStr := '';
                TempStr :=  padleft(TempStr+ copy(Str,StartingCol,W),W,' ');
             end;
             exit;
         end;
         Counter := 0;
         TempStr := '';
         while (Counter < ColumnLock)
         and (Counter < TabsArrayDim) do
         begin
            inc(Counter);
            TempStr := TempStr + padleft(GTabSubStr(Str,Counter),
                                         TabsArrayPtr^[succ(Counter)]-TabsArrayPtr^[Counter],
                                         ' ');
         end;
         {the Locked part has now been determined}
         Counter := length(TempStr);
         Tabs := pred(ListDetails.TabsArrayPos);
         while (Counter < W) and (Tabs < Listdetails.TabsArrayDim) do
         begin
            inc(Tabs);
            if Tabs =  Listdetails.TabsArrayDim then
               Wid := 80
            else
               Wid := TabsArrayPtr^[succ(Tabs)]-TabsArrayPtr^[Tabs];
            TempStr := TempStr + padleft(GTabSubStr(Str,Tabs),Wid,' ');
            Counter := length(TempStr);
         end;
         TempStr := copy(TempStr,1,W);
      end;
   end; {GetTitleStr}

begin
   with Listdetails do
   begin
      Counter := 0;
      if Scrollheader then
         X := StartingCol
      else
         X := 1;
      W := (X2-pred(X1))-ord(TotalNodes > succ(Y2-Y1));
      for I := 1 to ListMaxHeaders do
      begin
         if Listdetails.Headers[I] <> nil then
         begin
            inc(Counter);
            ClearText(succ(leftGap),TopGap+Counter,leftGap+W,TopGap+Counter,Col[ListHeaders]);
            GetTitleStr(Listdetails.Headers[I]^,Scrollheader);
            if (TempStr <> '') and (TempStr[1] = '^') then
            begin
               delete(TempStr,1,1);
               WriteBetween(succ(leftGap),X2-X1-RightGap,TopGap+Counter,Col[ListHeaders],TempStr);
            end
            else
               WriteAT(succ(leftGap),TopGap+Counter,Col[ListHeaders],TempStr);
         end;
      end;
      Counter := 0;
      if ScrollFooter then
         X := StartingCol
      else
         X := 1;
      for I := 1 to ListMaxFooters do
      begin
         if Listdetails.Footers[I] <> nil then
         begin
            inc(Counter);
            ClearText(succ(leftGap),Y2+Counter,leftGap+W,TopGap+Counter,Col[ListHeaders]);
            GetTitleStr(Listdetails.Footers[I]^,ScrollFooter);
            if (TempStr <> '') and (TempStr[1] = '^') then
            begin
               delete(TempStr,1,1);
               WriteBetween(succ(leftGap),X2-X1-RightGap,Y2+Counter,Col[ListHeaders],TempStr);
            end
            else
               WriteAT(succ(leftGap),Y2+Counter,Col[ListHeaders],TempStr);
         end;
      end;
   end;
end; {GridRefreshHeadFoot}

procedure GridRefresh(var ListDetails: ListCfg; Status:gStatus);
{Updates the Grid display}
var
  I : longint;
  Hdr: string;
  A,Y3: byte;
begin
   with ListDetails do
   begin
      if TabsArrayPtr <> nil then
         LastCol := TabsArrayPtr^[TabsArrayDim];
      if (ColumnLock > 0)
      and (TabsArrayPtr <> nil)
      and (StartingCol < TabsArrayPtr^[succ(ColumnLock)]) then
      begin
         StartingCol := TabsArrayPtr^[succ(ColumnLock)];
         TabsArrayPos := succ(ColumnLock);
      end;
      Y3 := Y2 - ord(LastCol > X2-X1);
      if (ActiveNode < TopNode)
      or (ActiveNode > TopNode + Y3 - Y1) then
      begin
         If Y3 > Y1 then
            TopNode := ActiveNode - (Y3 - Y1) div 2
         else
            TopNode := ActiveNode;
      end;
      if RowLock = 0 then
         for I := TopNode to TopNode + Y3 - Y1 do
            GridWriteItem(ListDetails,I,Status)
      else
      begin
         if RowLock < (Y3 - Y1) then
         begin
            for I := 1 to RowLock do
               GridWriteItem(ListDetails,I,Status);
            for I := TopNode to TopNode + (Y3 - Y1) - RowLock do
               GridWriteItem(ListDetails,I,Status);
         end
         else
            for I := 1 to Y3 - Y1 do
               GridWriteItem(ListDetails,I,Status);
      end;
      {time to write the headings}
      GridRefreshHeadFoot(Listdetails);
      WriteHeadingsHook(@Listdetails);
      GridWriteHScrollBar(Listdetails,Status);
      if (LastCol > X2-X1) and (TotalNodes > succ(Y2-Y1)) then
      begin
         if Status in [Activate,HiStatus] then
            A := Col[ListScrollbarHi]
         else
            A := Col[ListScrollbarNorm];
         WriteAT(X2,Y2,A,GridVars.GridCorner);
      end;
   end;
end; { GridRefresh }

procedure GridWindowStretch(var Listdetails: ListCfg);
{Called when user stretches the window}
var
   WP: WStructurePtr;
begin
   {First set the listdetails to reflect the revised window dimensions}
   WP := WinPtr(0); {top window}
   with Listdetails do
   begin
      WX1 := WP^.X;
      WY1 := WP^.Y;
      WX2 := WX1 + pred(WP^.Width);
      WY2 := WY1 + pred(WP^.Depth);
   end;
   SetInnerDimensions(Listdetails);
   GridRefresh(ListDetails,HiStatus);
   WinDrawAll;
end; {GridWindowStretch}

                       {****************************}
                       {**  Grid Cursor Movement  **}
                       {****************************}

function GridScrollUp(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
var TopRow: longint;
begin
   GridScrollUp := false;
   with ListDetails do
   begin
      if ActiveNode > TopNode then
         dec(ActiveNode)
      else
      begin
         if RowLock > 0 then
            TopRow := succ(RowLock)
         else
            TopRow := 1;
         if TopNode > TopRow then
         begin
            dec(TopNode);
            ActiveNode := TopNode;
            GridScrollUp := true;
         end;
      end;
   end;
end; {GridScrollUp}

function GridScrollDown(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
begin
   GridScrollDown := false;
   with ListDetails do
   begin
      if ActiveNode < TotalNodes then
      begin
         if ActiveNode < TopNode + Y2 - Y1 - RowLock - ord(LastCol > X2-X1) then
            inc(ActiveNode)
         else
         begin
            inc(TopNode);
            inc(ActiveNode);
            GridScrollDown := true;
         end;
      end;
   end;
end; {GridScrollDown}

function GridScrollPgDn(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
var Blockdepth: byte;
begin
   with ListDetails do
   begin
      if ActiveNode < TotalNodes then
      begin
         GridScrollPgDn := true;
         BlockDepth := succ(Y2 - Y1) - RowLock - ord(LastCol > X2-X1);
         if TopNode + Blockdepth > TotalNodes then
            ActiveNode := TotalNodes
         else
         begin
            inc(TopNode,Blockdepth);
            inc(ActiveNode,Blockdepth);
            if ActiveNode > TotalNodes then
               ActiveNode := TotalNodes;
         end;
      end
      else
         GridScrollPgDn := false;
   end;
end; {GridScrollPgDn}

function GridScrollPgUp(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
var Blockdepth: byte;
begin
   GridScrollPgUp := false;
   with ListDetails do
   begin
      if ActiveNode > succ(RowLock) then
      begin
         if TopNode > succ(RowLock) then
            GridScrollPgUp := true;
         BlockDepth := succ(Y2 - Y1) - RowLock - ord(LastCol > X2-X1);
         if TopNode - BlockDepth < succ(RowLock) then
            TopNode := succ(RowLock)
         else
            dec(TopNode,BlockDepth);
         dec(ActiveNode,Blockdepth);
         if ActiveNode < TopNode then
            ActiveNode := TopNode;
      end;
   end;
end; {GridScrollPgUp}

function GridScrollHome(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
begin
   with ListDetails do
   begin
      GridScrollHome := (TopNode > succ(RowLock));
      TopNode := succ(RowLock);
      ActiveNode := TopNode;
   end;
end; {GridScrollHome}

function GridScrollEnd(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the Grid needs to be
 refreshed}
begin
   with ListDetails do
   begin
      if TopNode + Y2 - Y1 - RowLock - ord(LastCol > X2-X1) < TotalNodes then
      begin
         GridScrollEnd := true;
         TopNode := TotalNodes - (Y2 - Y1) + RowLock + ord(LastCol > X2-X1);
      end
      else
         GridScrollEnd := false;
      ActiveNode := TotalNodes;
   end;
end; {GridScrollEnd}

function GridScrollLeft(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the list needs to be
 refreshed}
var
  PrevPos: integer;
  TempStr: string;
begin
   with ListDetails do
   begin
      if (StartingCol = 1)
      or ((ColumnLock > 0) and (ColumnLock = pred(StartingCol))) then
         GridScrollLeft := false
      else
      begin
         GridScrollLeft := true;
         if TabsArrayPtr <> nil then {use Tab Array to determine next tabstop}
         begin
            if TabsArrayPos > 1 then
            begin
               dec(TabsArrayPos);
               StartingCol := TabsArrayPtr^[TabsArrayPos];
               if StartingCol < ColumnLock then
                  StartingCol := succ(ColumnLock);
            end;
         end
         else
            StartingCol := pred(StartingCol);
      end;
   end;
end; {GridScrollLeft}

function GridScrollRight(var ListDetails: ListCfg): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the list needs to be
 refreshed}
var
  NextPos: integer;
  TempStr: string;
begin
   with ListDetails do
   begin
      if StartingCol = LastCol then
         GridScrollRight := false
      else
      begin
         GridScrollRight := true;
         if TabsArrayPtr <> nil then {use TabString to determine next tabstop}
         begin
            if TabsArrayPos < TabsArrayDim then
            begin
               inc(TabsArrayPos);
               StartingCol := TabsArrayPtr^[TabsArrayPos];
               if StartingCol < ColumnLock then
                  StartingCol := succ(ColumnLock);
            end;
         end
         else
         begin
           StartingCol := succ(StartingCol);
               if StartingCol < ColumnLock then
                  StartingCol := succ(ColumnLock);

         end;
      end;
   end;
end; {GridScrollRight}

function GridScrollChar(var ListDetails: ListCfg;Ch:char): boolean;
{Updates the ActiveNode and TopNode parameters and returns
 true if TopNode is modified, i.e. if the list needs to be
 refreshed}
var
   LastPick,
   L: longint;
   Str:string[1];
   Found:boolean;
begin
   GridScrollChar := false;
   with ListDetails do
   begin
      {first search from top of list looking for match}
      L := 0;
      Found := false;
      while not found and (L <= TotalNodes) do
      begin
         inc(L);
         Str := GetStr(Listdetails.DataSource,L,1,1);
         Found := Str[1] = Ch;
      end;
      if Found then
      begin
         ActiveNode := L;
         if (ColCount = 1) or (LastColWidth = RealColWidth) then
            LastPick := ColCount * RowCount
         else
            LastPick := pred(ColCount) * RowCount;
         if (ActiveNode < TopNode)
         or (ActiveNode > pred(TopNode) + LastPick) then
         begin
            TopNode := ActiveNode;
            GridScrollChar := true;
         end;
      end;
   end;
end; {GridScrollChar}

procedure GridMoveIt(var ListDetails: ListCfg; Direction: byte);
{}
var
  Repaint: boolean;
  OldAct: integer;
begin
   with ListDetails do
   begin
      OldAct := ActiveNode;
      if ((Direction in [1,3,5]) and (ActiveNode = 1))
      or ((Direction in [2,4,6]) and (ActiveNode = TotalNodes)) then
         exit;
      case Direction of
        1: Repaint := GridScrollUp(ListDetails);
        2: Repaint := GridScrollDown(ListDetails);
        3: Repaint := GridScrollPgUp(ListDetails);
        4: Repaint := GridScrollPgDn(ListDetails);
        5: Repaint := GridScrollHome(ListDetails);
        6: Repaint := GridScrollEnd(ListDetails);
        7: Repaint := GridScrollLeft(ListDetails);
        8: Repaint := GridScrollRight(ListDetails);
      end;
      if Repaint then
         GridRefresh(ListDetails,HiStatus)
      else if OldAct <> ActiveNode then
      begin
         GridWriteItem(ListDetails,OldAct,HiStatus);
         GridWriteItem(ListDetails,ActiveNode,HiStatus);
      end;
   end;
end; { GridMoveIt }

                          {*********************}
                          {**  Tagging Procs  **}
                          {*********************}

procedure ToggleTagState(var ListDetails: ListCfg);
{}
begin
   with ListDetails do
   if AllowTagging then
   begin
      SetBit(DataSource,ActiveNode,TagBit,not GetBit(DataSource,ActiveNode,TagBit));
      GridWriteItem(Listdetails,ActiveNode,HiStatus);
   end;
end; { ToggleTagState }

procedure SetTag(var ListDetails: ListCfg; On: boolean);
{}
var State: boolean;
begin
   with ListDetails do
   if AllowTagging then
   begin
      State := GetBit(DataSource,ActiveNode,TagBit);
      if State <> On then
      begin
         SetBit(DataSource,ActiveNode,TagBit,On);
         GridWriteItem(Listdetails,ActiveNode,HiStatus);
      end;
   end;
end; { SetTag }

procedure SetTagAll(var ListDetails: ListCfg; On: boolean);
{}
var I : longint;
begin
   with ListDetails do
   if AllowTagging then
   begin
      for I := 1 to TotalNodes do
         SetBit(DataSource,I,TagBit,On);
      GridRefresh(ListDetails,HiStatus)
   end;
end; { SetTagAll }

                       {***************************}
                       {**  Grid Mouse Handling  **}
                       {***************************}

procedure GridMouseVScroll(var ListDetails: ListCfg);
{}
var
  L,M,R: boolean;
  TopY,BotY,
  X,Y,ElevatorY:byte;
  WaitTime: integer;

  procedure ScrollUpOne;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = X2) and (Y = TopY) and L then
           GridMoveIt(Listdetails,1);
        DelayIt(L,InWindow,WaitTime);
     until not L;
  end; { ScrollUpOne }

  procedure ScrollDownOne;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = X2) and (Y = BotY) and L then
           GridMoveIt(ListDetails,2);
        DelayIt(L,InWindow,WaitTime);
     until not L;
  end; { ScrollDownOne }

  procedure ScrollUpward;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if ActiveNode <> 1 then
        begin
           if (X = X2) and (Y >= TopY) and (Y <= ElevatorY) and L then
              GridMoveIt(ListDetails,3);   {PgUp effect}
           DelayIt(L,InWindow,WaitTime);
        end;
     until not L;
  end; { ScrollUpward }

  procedure ScrollDownward;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if ActiveNode <> TotalNodes then
        begin
           if (X = X2) and (Y <= Y2) and (Y >= ElevatorY) and L then
              GridMoveIt(ListDetails,4);   {PgDn effect}
           DelayIt(L,InWindow,WaitTime);
        end;
     until not L;
  end; { ScrollDownward }

  procedure ScrollDragElevator;
  {}
  var
    OldY:byte;
    NewActive:longint;
  begin
     OldY := Y;
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = X2) and (Y < BotY) and (Y > TopY) and (Y <> OldY) and L then
        begin
           OldY := Y;
           if Y = succ(TopY) then
              NewActive := 1
           else if Y = pred(BotY) then
              NewActive := TotalNodes
           else
              NewActive := TotalNodes * (Y - TopY) div (BotY-TopY);
           if NewActive <> ActiveNode then
           begin
              ActiveNode := NewActive;
              TopNode := NewActive;
              GridRefresh(ListDetails,HiStatus);
           end;
           if WindowHasFocus then
              WinDrawTop;
        end;
     until not L;
  end; { ScrollElevator }

begin
   with ListDetails do
   begin
      InWindow := WindowHasFocus;
      WaitTime := KeyVars.InitScrollDelay;
      repeat
         MouseStatusWin(L,M,R,X,Y);
         if L and (X = X2) then
         begin
            TopY := Y1;
            BotY := Y2 - ord(LastCol > X2-X1);
            if Y = TopY then
               ScrollUpOne
            else if Y = BotY then
               ScrollDownOne
            else    {mouse pressed along scroll bar body}
            begin
               ElevatorY := GetVScrollBarElevator(TopY,BotY,ActiveNode,TotalNodes);
               if ((Y = succ(TopY)) and (Y=ElevatorY) and (ActiveNode > RowLock))
               or (Y > TopY) and (Y < ElevatorY) then
                  ScrollUpward
               else if ((Y = pred(BotY)) and (Y=ElevatorY)
                        and
                        (ActiveNode < TotalNodes)
                       )
                       or ((Y < BotY) and (Y > ElevatorY))  then
                  ScrollDownward
               else {user is dragging elevator}
                  ScrollDragElevator;
             end;
         end;
      until not L;
      MouseRelease;
   end;
end; { GridMouseVScroll }

procedure GridMouseHScroll(var ListDetails: ListCfg);
{}
var
  L,M,R: boolean;
  TopY,BotY,
  X,Y,ElevatorX:byte;
  WaitTime: integer;

  procedure ScrollLeftOne;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = X1) and (Y = Y2) and L then
           GridMoveIt(Listdetails,7);
        DelayIt(L,InWindow,WaitTime);
     until not L;
  end; { ScrollLeftOne }

  procedure ScrollRightOne;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = pred(X2)) and (Y = Y2) and L then
           GridMoveIt(ListDetails,8);
        DelayIt(L,InWindow,WaitTime);
     until not L;
  end; { ScrollRightOne }

  procedure ScrollLeftward;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if StartingCol <> RowLock then
        begin
           if (Y = Y2) and (X >= succ(X1)) and (X <= ElevatorX) and L then
              GridMoveIt(ListDetails,7);
           DelayIt(L,InWindow,WaitTime);
        end;
     until not L;
  end; { ScrollLeftward }

  procedure ScrollRightward;
  {}
  begin
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if StartingCol <> LastCol then
        begin
           if (Y = Y2) and (X <= X2-2) and (X >= ElevatorX) and L then
              GridMoveIt(ListDetails,8);   {PgDn effect}
           DelayIt(L,InWindow,WaitTime);
        end;
     until not L;
  end; { ScrollRightward }

  procedure ScrollDragElevator;
  {}
  var
    OldY:byte;
    NewActive:longint;
  begin
     OldY := Y;
     with ListDetails do
     repeat
        MouseStatusWin(L,M,R,X,Y);
        if (X = X2) and (Y < BotY) and (Y > TopY) and (Y <> OldY) and L then
        begin
           OldY := Y;
           if Y = succ(TopY) then
              NewActive := 1
           else if Y = pred(BotY) then
              NewActive := TotalNodes
           else
              NewActive := TotalNodes * (Y - TopY) div (BotY-TopY);
           if NewActive <> ActiveNode then
           begin
              ActiveNode := NewActive;
              TopNode := NewActive;
              GridRefresh(ListDetails,HiStatus);
           end;
           if WindowHasFocus then
              WinDrawTop;
        end;
     until not L;
  end; { ScrollElevator }

begin
   with ListDetails do
   begin
      InWindow := WindowHasFocus;
      WaitTime := KeyVars.InitScrollDelay;
      repeat
         MouseStatusWin(L,M,R,X,Y);
         if L and (Y = Y2) then
         begin
            if X = X1 then
               ScrollLeftOne
            else if X = pred(X2) then
               ScrollRightOne
            else    {mouse pressed along scroll bar body}
            begin
               ElevatorX := GetVScrollBarElevator(X1,pred(X2),StartingCol,LastCol);
               if ((X = succ(X1)) and (X=ElevatorX) and (StartingCol > RowLock))
               or (X > X1) and (X < ElevatorX) then
                  ScrollLeftward
               else if ((X = X2-2) and (X=ElevatorX)
                        and
                        (StartingCol < LastCol)
                       )
                       or ((X <= X2-2) and (X > ElevatorX))  then
                  ScrollRightward
               else {user is dragging elevator}
                  ScrollDragElevator;
             end;
         end;
      until not L;
      MouseRelease;
   end;
end; { GridMouseHScroll }

procedure GridMouseEndHome(var ListDetails: ListCfg);
{Moves to lower right corner of grid}
begin
   with Listdetails Do
   begin
      if TabsArrayPtr <> nil then
      begin
         StartingCol := TabsArrayPtr^[TabsArrayDim];
         TabsArrayPos := TabsArrayDim;
      end
      else
         StartingCol := LastCol;
      ActiveNode := TotalNodes;
      TopNode := ActiveNode;
      GridRefresh(ListDetails,HiStatus);
      MouseRelease;
   end;
end; { GridMouseEndHome }

function GridTargetPick(var ListDetails: ListCfg;X,Y:byte): longint;
{return the pick number of the pick pointed to by
 the coordinates X,Y. If no pick is at those coordinates, a
 0 is returned}
begin
   with ListDetails do
   begin
      if  (X >= X1)
      and (X < X2)   {last column is for scroll bar}
      and (Y >= Y1 + RowLock)
      and (Y <= Y2 - ord(LastCol > X2-X1))
      then
      begin
         X := succ(X - X1);
         Y := succ(Y - Y1 - RowLock);
         if pred(TopNode) + Y <= TotalNodes then
         begin
         (*
            KeyVars.LastX := pred(TopNode) + Y;
            GridTargetPick := KeyVars.LastX;
         *)
            GridTargetPick := pred(TopNode) + Y;
            exit;
         end;
      end;
      GridTargetPick := 0;
      KeyVars.LastX := 0;
   end;
end; {GridTargetPick}

procedure GridMouseSelect(var ListDetails: ListCfg);
{Called when mouse pressed on field and held down}
var
  L,M,R: boolean;
  X,Y:byte;
  OldAct,
  NewAct: longint;

   function OnActiveNode: boolean;
   {}
   begin
      MouseStatusWin(L,M,R,X,Y);
      with ListDetails do
         OnActiveNode := (ActiveNode = GridTargetPick(Listdetails,X,Y));
   end; { OnActiveNode }

   function CheckforTagChange:boolean;
   {}
   begin
      CheckForTagChange := false;
      with Listdetails do
      if AllowTagging then
      begin
         if OnActiveNode and L then
         begin
            ToggleTagState(Listdetails);
            if WindowHasFocus then
               WinDrawTop;
            MouseRelease;
            if OnActiveNode then   {see if still on item if not re-toggle the mouse}
               CheckForTagChange := true
            else
               ToggleTagState(Listdetails);
         end;
      end;
   end; { CheckforTagChange }

begin
   if not CheckForTagChange then
   with ListDetails do
   repeat
      MouseStatusWin(L,M,R,X,Y);
      if L then
      begin
         OldAct := ActiveNode;
         NewAct := GridTargetPick(Listdetails,X,Y);
         if (NewAct <> 0) and (NewAct <> OldAct) then
         begin
            ActiveNode := NewAct;
            GridWriteItem(ListDetails,OldAct,HiStatus);
            GridWriteItem(ListDetails,ActiveNode,HiStatus);
            if WindowHasFocus then
               WinDrawTop;
         end;
      end;
   until not L;
   MouseRelease;
end; {GridMouseSelect}

procedure GridProcessKey(var ListDetails: ListCfg;var K:word;X,Y:byte;MakeLocal:boolean);
{}
var
   Ch: char;
   OldAct: longint;
begin
   with ListDetails do
   begin
      CharHook(K,X,Y); {call user hook}
      if MakeLocal then
         if IsWinKey(K,X,Y) then
            WinProcessKey(K,X,Y);
      K := CapitalWord(K);
      if (K = 500) or (K = 540) then
      begin
         if MakeLocal then {convert to local coords}
         begin
            X := WinLocalX(0,X);
            Y := WinLocalY(0,Y);
         end;
         if K = 500 then
         begin
            if ((LastCol > X2-X1) and (TotalNodes > succ(Y2-Y1)))
                     and (X=X2)
                     and (Y=Y2) then
               GridMouseEndHome(Listdetails)
            else if (X = X2) and (TotalNodes > succ(Y2-Y1)) then
               GridMouseVScroll(Listdetails)
            else if (LastCol > X2-X1) and (Y = Y2) then
               GridMouseHScroll(Listdetails)
            else
               GridMouseSelect(Listdetails);
         end
         else if GridTargetPick(Listdetails,X,Y) = ActiveNode then
            K := 540  {double click}
         else
            K := 0;
      end
      else if K = ListVars.ToggleKey then
           ToggleTagState(Listdetails)
      else if K = ListVars.TagKey then
           SetTag(Listdetails,true)
      else if K = ListVars.UnTagKey then
           SetTag(Listdetails,false)
      else if K = ListVars.TagAllKey then
           SetTagAll(Listdetails,true)
      else if K = ListVars.UnTagAllKey then
           SetTagAll(Listdetails,false)
      else
      case K of
         328: GridMoveIt(ListDetails,1);
         336: GridMoveIt(ListDetails,2);
         329: GridMoveIt(ListDetails,3);
         337: GridMoveIt(ListDetails,4);
         327: GridMoveIt(ListDetails,5);
         335: GridMoveIt(ListDetails,6);
         331: GridMoveIt(ListDetails,7);
         333: GridMoveIt(ListDetails,8);
         602: if WindowHasFocus then
                 GridWindowStretch(Listdetails);
         else if (K >= 55) and (K <= 255) then
         begin
            Ch := chr(CapitalWord(K));
            OldAct := ActiveNode;
            if GridScrollChar(Listdetails,Ch) then
               GridRefresh(ListDetails,HiStatus)
            else if OldAct <> ActiveNode then
            begin
               GridWriteItem(ListDetails,OldAct,HiStatus);
               GridWriteItem(ListDetails,ActiveNode,HiStatus);
            end;
         end;
      end; {case}
      WriteHeadingsHook(@Listdetails);
      HindHook(@ListDetails);
   end;
end; { GridProcessKey }

function DisplayGridEngine(var ListDetails: ListCfg;Tit:StrScreen): byte;
{INTERNAL}
var
  Handle: integer;

   procedure SetWindow;
   {}
   begin
      with ListVars do
      with ListDetails do
      begin
         Handle := WinCreate(WX1,WY1,WX2,WY2,WStyle);
         WinSetType(Handle,WrapWinType);
         WinSetTitle(Handle,Tit);
         WinSetShowNum(Handle,false);
         WinSetColor(Handle,WinBorder,Col[ListBorder1]);
         WinSetColor(Handle,WinBorder3DOut,Col[ListBorder1]);
         WinSetColor(Handle,WinBorder3dIn,Col[ListBorder2]);
         WinSetColor(Handle,WinBorderOff,Col[ListBorderOff]);
         WinSetColor(Handle,WinIcons,Col[ListIcons]);
         WinSetColor(Handle,WinBody,Col[ListNorm1]);
         WinSetColor(Handle,WinTitle,Col[ListTitle]);
         if ListDetails.ColWidth <> 0 then
            WinSetMinSize(Handle,ListDetails.ColWidth+2+2*ord(WinStyle in [7,8]),WinVars.MinDepth);
         WinPaint(Handle);
      end;
   end; {SetWindow}

begin
   with ListDetails do
   begin
      if WX1 = 0 then  {user hasn't set the window}
      begin
         WX1 := ListVars.WX1;
         WY1 := ListVars.WY1;
         WX2 := ListVars.WX2;
         WY2 := ListVars.WY2;
      end;
      if AllowTagging then {Jubelt}
         inc(WX2);
      SetInnerDimensions(Listdetails);
      InWindow := true;
      SetWindow;
      WinDisplay(Handle);
      if (TabsArrayPtr = nil) and (ColumnLock > 0) then
         StartingCol := succ(ColumnLock);
   end;
   GridRefresh(ListDetails,HiStatus);
   ListDetails.HindHook(@ListDetails); {call it once after window is created}
   DisplayGridEngine := Handle;
end; { DisplayGridEngine }

procedure ProcessGridInput(var ListDetails: ListCfg; OnDeskTop:boolean);
{}
begin
   with Listdetails do
   with KeyVars do
   begin
      GridProcessKey(ListDetails,LastKey,LastX,LastY,true);
      if not OnDeskTop
      and (
              (LastKey = 600)
           or (LastKey = 27)
           or ((LastKey = 540) and (LastX <> 0))
           or (LastKey = 13)
          ) then
      begin
          LastAction := SelectHook(@ListDetails);
          if LastAction = Refresh then
          begin
             case DataType of
                SourceStrLL: TotalNodes := StringLL(dataSource^).TotalNodes;
                SourceSLL: TotalNodes := LinkVars.ActiveSLL^.TotalNodes;
                SourceDLL: TotalNodes := LinkVars.ActiveDLL^.TotalNodes;
             end;
             if (ActiveNode > TotalNodes) or (TopNode > TotalNodes) then
             begin
                ActiveNode := 1;
                TopNode := 1;
             end;
             GridRefresh(ListDetails,HiStatus)
          end;
      end
      else
      begin
         if LastKey = 600 then
            LastAction := Escaped
         else
            LastAction := none;
      end;
   end;
end; { ProcessGridInput }

procedure RunGrid(var ListDetails: ListCfg;Tit:StrScreen);
{}
var Handle:integer;
begin
   Handle := DisplayGridEngine(Listdetails,Tit);
   WinDrawAll;
   with Listdetails do
   with KeyVars do
   repeat
      GetInput;
      ProcessGridInput(Listdetails,false);
      WinDrawAll;
   until LastAction in [Stop1..Escaped];
   ListVars.LastActiveItem := ListDetails.ActiveNode;
   WinDispose(Handle);
   MouseRelease;
end; {RunGrid}


{$IFOPT F-}
   {$DEFINE FOFF}
   {$F+}
{$ENDIF}
procedure GridProcessKeyOnDesktop;
{}
var
   Handle: integer;
   WinP: WStructurePtr;
   LDP : ^ListCfg;
   K: word;
   X,Y: byte;
begin
   Handle := WinWithFocus;
   WinP := WinPtr(Handle);
   LDP := WinP^.UserData;
   ProcessGridInput(LDP^,true);
   if LDP^.LastAction in [Stop1..Escaped] then
      if ListCloseHandler(Handle) then
         {close aborted};
end; { GridProcessKeyOnDesktop }

{$IFDEF FOFF}
   {$F-}
   {$UNDEF FOFF}
{$ENDIF}

function LaunchGrid(var ListDetails: ListCfg;Tit:StrScreen; CloseProc:ListCloseProc): byte;
{}
var
   WinP: WStructurePtr;
   Handle: byte;
begin
   WinFadeTopWin;
   Listdetails.DeskListCloseCallBack := CloseProc;
   if WinVars.DesktopFocusStyle <> 0 then
      Listdetails.WStyle := WinVars.DesktopFocusStyle;
   Handle := DisplayGridEngine(Listdetails,Tit);
   if Handle <> 0 then
   begin
      WinP := WinPtr(Handle);
      if WinP <> nil then
      begin
         WinP^.ProcessKeyProc := GridProcessKeyOnDeskTop;
         WinP^.CloseWinProc := ListCloseHandler;
         WinP^.ChangeFocusProc := ListFocusHandler;
         WinP^.UserData := @ListDetails;
      end;
      WinDrawTop;
   end;
   LaunchGrid := Handle;
end; {LaunchGrid}

{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
{                                                     }
{       U N I T     I N I T I A L I Z A T I O N       }
{                                                     }
{|||||||||||||||||||||||||||||||||||||||||||||||||||||}
procedure GridDefaultSettings;
{}
begin
   GridVars.GridCorner := '≥';
end; { GridDefaultSettings }

procedure GoldGridInit;
{}
begin
   with GridVars do
   begin
      LastECode := 0;
      EMsgFunc := GridEMsg;
   end;
   GridDefaultSettings;
end; {GoldGridInit}

begin
   GoldGridInit;
end.